home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
graphic
/
1svga.zip
/
LOOK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-05-29
|
3KB
|
103 lines
{ Look Text }
uses Dos,Txt;
var Texts:array[0..15000] of ^string;
LineMax:integer;
DirInfo:SearchRec;
Dir:DirStr; Name:NameStr; Ext:ExtStr;
{ ─────────────── SetColor ─────────────── }
procedure SetColor;
const C:array[0..3] of byte=(0,104,54,30);
var Pal:array[0..314] of byte;
Pal17:array[0..16] of byte;
I:integer;
begin
VideoMode($13);
GetPalette(0,105,Pal);
VideoMode(3);
for I:=0 to 3 do SetPalette(I,1,Pal[3*C[I]]);
SetPalette(4,12,Pal[64*I]);
for I:=0 to 15 do Pal17[I]:=I; Pal17[16]:=0;
SetPalette17(Pal17);
end;
{ ─────────────── ReadTextFile ─────────────── }
procedure ReadTextFile(Filename:string);
var File1:text;
St:string;
I:integer;
begin
Assign(File1,Filename); Reset(File1);
LineMax:=0;
while not Eof(File1) do begin
if (LineMax>15000) or (MemAvail<256) then begin Close(File1); Exit; end;
Readln(File1,St);
for I:=1 to 255 do if St[I]=#9 then
begin Delete(St,I,1); Insert(' ',St,I); end;
GetMem(Texts[LineMax],Length(St)+1);
Texts[LineMax]^:=St;
Inc(LineMax);
end;
Close(File1);
end;
{ ─────────────── ShowPageText ─────────────── }
procedure ShowPageText(X,Y:integer);
var N,I,J:integer;
St:string[80];
begin
if LineMax>23 then J:=23 else J:=LineMax;
for I:=0 to J-1 do begin
N:=Length(Texts[Y+I]^)-X;
if N<0 then N:=0; if N>80 then N:=80;
St[0]:=#80; FillChar(St[1],80,' ');
Move(Texts[Y+I]^[X+1],St[1],N);
PrintText(1,2+I,$14+I shr 1,St);
end;
end;
{ ─────────────── Look ─────────────── }
procedure Look;
var K,X,Y,Z:integer;
St:string[5];
begin
FSplit(ParamStr(1),Dir,Name,Ext);
ReadTextFile(Dir+DirInfo.Name);
SetCurShape($20,0);
TextBar(1, 1,80, 1,$23,' ');
TextBar(1, 2,80,23,$13,' ');
TextBar(1,25,80, 1,$23,' ');
PrintText( 3, 1,$23,'Look V1.1/View Text File (C) 1994 Jou-Nan Chen');
PrintText(56, 1,$23,'Line Colume');
PrintText( 3,25,$23,'Arrows,PgUp,PgDn,Home,End-Scroll text Esc-Quit');
X:=0; Y:=0; K:=0;
repeat
Str(Y+1,St); TextBar(61,1,5,1,$23,' ');
PrintText(61,1,$26,St);
Str(X+1,St); TextBar(74,1,3,1,$23,' ');
PrintText(74,1,$26,St);
if (K<>$2166) and (K<>$2146) then ShowPageText(X,Y);
K:=Key;
case K of
$4800:Dec(Y); $5000:Inc(Y); { Up,Down }
$4900:Dec(Y,23); $5100:Inc(Y,23); { PgUp,PgDn }
$4B00:Dec(X,20); $4D00:Inc(X,20); { Left,Right }
$4700:begin X:=0; Y:=0; end; { Home }
$4F00:begin X:=0; Y:=LineMax-23; end; { End }
end;
if Y>LineMax-23 then Y:=LineMax-23; if Y<0 then Y:=0;
if X>236 then X:=236; if X<0 then X:=0;
until K=$011B; { Esc }
SetCurShape(6,7); SetCurPos(1,25); TextBar(1,25,80,1,$07,' ');
end;
begin
if ParamCount=0 then
begin Writeln('Usage: Look Filename'); Halt(1); end;
if ParamCount=1 then begin
FindFirst(ParamStr(1),Archive,DirInfo);
if DosError<>0 then
begin Writeln('No such file !'); Halt(1); end;
end;
SetColor; Look; VideoMode(3);
end.